home *** CD-ROM | disk | FTP | other *** search
/ Cobra Utilities for Doom & Doom II / Cobra Utilities For Doom & Doom II - Disc 2.iso / files / program / ktsdht10 / mouse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-12  |  6.0 KB  |  281 lines
  1. unit Mouse;
  2.  
  3. interface
  4.  
  5. type  CursorArray=array[1..256] of byte;
  6.  
  7. const    UseMouse:Boolean=false;
  8.         MouseIsVisible:boolean=false;
  9.         FakeCursor:boolean=false;
  10.         StdCursor:cursorarray          = (0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
  11.                                                      0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
  12.                                                      0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,
  13.                                                      0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,
  14.                                                      0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  15.                                                      0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,
  16.                                                      0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,
  17.                                                      0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,
  18.                                                      0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,
  19.                                                      0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,
  20.                                                      0,0,1,0,0,0,1,1,1,1,1,1,1,1,1,1,
  21.                                                      0,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,
  22.                                                      1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,
  23.                                                      1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,
  24.                                                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
  25.                                                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1);
  26.  
  27.         WaitCursor:cursorarray          = (1,1,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
  28.                                                       1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,
  29.                                                       1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,
  30.                                                       1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,
  31.                                                       1,1,1,0,0,1,1,1,1,1,0,0,1,1,1,1,
  32.                                                       1,1,1,1,0,0,1,1,1,0,0,1,1,1,1,1,
  33.                                                       1,1,1,1,1,0,0,1,0,0,1,1,1,1,1,1,
  34.                                                       1,1,1,1,1,1,0,1,0,1,1,1,1,1,1,1,
  35.                                                       1,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,
  36.                                                       1,1,1,1,1,0,0,1,0,0,1,1,1,1,1,1,
  37.                                                       1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,
  38.                                                       1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,
  39.                                                       1,1,1,0,0,0,0,1,0,0,0,0,1,1,1,1,
  40.                                                       1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,1,
  41.                                                       1,1,1,0,0,1,1,1,1,1,0,0,1,1,1,1,
  42.                                                       1,1,0,0,0,0,0,0,0,0,0,0,0,1,1,1);
  43.  
  44. Type    PMouseCursorDef=^TMouseCursorDef;
  45.         TMouseCursorDef=record
  46.             XSize        :word;
  47.             YSize        :word;
  48.             Reserved    :word;
  49.             ImageBuff:array[1..256] of byte;
  50.         end;
  51.  
  52. Procedure InitMouse;
  53. Procedure DrawFakeCursor(x,y:word);
  54. Procedure ShowMousePointer;
  55. procedure HideMousePointer;
  56. procedure SetPointerType(NewPointer:byte);
  57. Procedure GetMouseCoords(var x,y,buttons:integer);
  58. procedure SetMouseCoords(x,y:integer);
  59. procedure SetMouseLimits(x0,y0,x1,y1:integer);
  60. procedure ResetMouseLimits;
  61. Procedure DoneMouse;
  62.  
  63. implementation
  64.  
  65. uses Dos,Graph,crt;
  66.  
  67. const MouseInt=$33;
  68.  
  69. type     Ba=Array[1..1024] of byte;
  70.  
  71. var    Regs:Registers;
  72.         OldX,OldY:word;
  73.         MouseBuff:pointer;
  74.         FakeCursorDef:TMouseCursorDef;
  75.  
  76. {initialize the mouse driver}
  77.  
  78. Procedure InitMouse;
  79.  
  80.     var t:integer;
  81.  
  82.     begin
  83.         regs.ax:=$0000;
  84.         intr(MouseInt,regs);
  85.         if regs.ax=$FFFF then
  86.             UseMouse:=TRUE
  87.         else
  88.             UseMouse:=FALSE;
  89.         if FakeCursor then begin
  90.             GetMem(MouseBuff,imagesize(1,1,17,17));
  91.             regs.ax:=$1A;
  92.             regs.bx:=500;
  93.             regs.cx:=500;
  94.             regs.dx:=50;
  95.             intr($33,regs);
  96.             FakeCursorDef.XSize:=15;
  97.             FakeCursorDef.YSize:=15;
  98.             SetMouseLimits(1,1,4952,3720);
  99.             for t:=1 to 256 do
  100.                 if StdCursor[t] = 0 then
  101.                     FakeCursorDef.ImageBuff[t]:=86
  102.                 else
  103.                     FakeCursorDef.ImageBuff[t]:=0;
  104.         end;
  105.     end;
  106.  
  107. Procedure DrawFakeCursor(x,y:word);
  108.  
  109.  
  110.     begin
  111.         if not UseMouse then
  112.             exit;
  113.         if MouseIsVisible  and ((x <> OldX) or (y <> OldY)) then begin
  114.             if OldX > 623 then
  115.                 OldX:=623;
  116.             PutImage(OldX,OldY,MouseBuff^,NormalPut);
  117.             GetImage(x,y,x+16,y+16,MouseBuff^);
  118.             SetColor(15);
  119.             PutImage(x,y,FakeCursorDef,xorPut);
  120. {            line(x,y,x+5,y);
  121.             line(x,y,x,y+5);
  122.             line(x+5,y,x+5,y+5);
  123.             line(x,y+5,x+5,y+5);}
  124.             OldX:=x;
  125.             OldY:=y;
  126.         end;
  127.     end;
  128.  
  129. {show the pointer}
  130.  
  131. Procedure ShowMousePointer;
  132.  
  133.     var x,y,b:integer;
  134.  
  135.     begin
  136.         if not UseMouse then
  137.             exit;
  138.         if not FakeCursor then begin
  139.             regs.ax:=$0001;
  140.             intr(MouseInt,regs);
  141.          end
  142.         else begin
  143.             GetMouseCoOrds(x,y,b);
  144.             x:=x div 8;
  145.             y:=y div 8;
  146.             GetImage(x,y,x+16,y+16,MouseBuff^);
  147.             Oldx:=x;
  148.             Oldy:=y;
  149.             DrawFakeCursor(x,y);
  150.         end;
  151.         MouseIsVisible:=True;
  152.     end;
  153.  
  154. {hide the pointer}
  155.  
  156. procedure HideMousePointer;
  157.  
  158.     begin
  159.         if not UseMouse then
  160.             exit;
  161.         if not FakeCursor then begin
  162.             regs.ax:=$0002;
  163.             intr(MouseInt,regs);
  164.          end
  165.         else
  166.             PutImage(OldX,OldY,MouseBuff^,NormalPut);
  167.         MouseIsVisible:=False;
  168.     end;
  169.  
  170. Procedure SetPointerType(NewPointer:byte);
  171.  
  172.     var    TempArry:cursorarray;
  173.             t:integer;
  174.  
  175.     begin
  176.         if FakeCursor then begin
  177.             case NewPointer of
  178.                 1:TempArry:=StdCursor;
  179.                 2:TempArry:=WaitCursor;
  180.              else
  181.                 TempArry:=StdCursor;
  182.             end;
  183.             for t:=1 to 256 do
  184.                 if TempArry[t] = 0 then
  185.                     FakeCursorDef.ImageBuff[t]:=5
  186.                 else
  187.                     FakeCursorDef.ImageBuff[t]:=0;
  188.         end;
  189.     end;
  190.  
  191. {read pointer coordinates}
  192.  
  193. Procedure GetMouseCoords(var x,y,buttons:integer);
  194.  
  195.     begin
  196.         if not UseMouse then
  197.             exit;
  198.         regs.ax:=$0003;
  199.         intr(MouseInt,regs);
  200.         x:=regs.cx;
  201.         y:=regs.dx;
  202.         buttons:=regs.bx;
  203.         if FakeCursor then begin
  204.             x:=x div 8;
  205.             y:=y div 8;
  206.         end;
  207.     end;
  208.  
  209. {change pointer coordinates}
  210.  
  211. procedure SetMouseCoords(x,y:integer);
  212.  
  213.     begin
  214.         if not UseMouse then
  215.             exit;
  216.         regs.ax:=$0004;
  217.         regs.cx:=x;
  218.         regs.dx:=y;
  219.         intr(MouseInt,regs);
  220.     end;
  221.  
  222. {set horizontal and vertical limits (constrain pointer in a box)}
  223.  
  224. procedure SetMouseLimits(x0,y0,x1,y1:integer);
  225.  
  226.     begin
  227.         if not UseMouse then
  228.             exit;
  229.         regs.ax:=$0007;
  230.         regs.cx:=x0;
  231.         regs.dx:=x1;
  232.         intr(MouseInt,regs);
  233.         regs.ax:=$0008;
  234.         regs.cx:=y0;
  235.         regs.dx:=y1;
  236.         intr(MouseInt,regs);
  237.     end;
  238.  
  239.  
  240. {reset horizontal and vertical limits}
  241.  
  242. procedure ResetMouseLimits;
  243.  
  244.     begin
  245.         if not UseMouse then
  246.             exit;
  247.         regs.ax:=$0007;
  248.         regs.cx:=0;
  249.         regs.dx:=640;
  250.         intr(MouseInt,regs);
  251.         regs.ax:=$0008;
  252.         regs.cx:=0;
  253.         regs.dx:=480;
  254.         intr(MouseInt,regs);
  255.     end;
  256.  
  257. Procedure DoneMouse;
  258.  
  259.     begin
  260.         if not UseMouse then
  261.             exit;
  262.         if FakeCursor then begin
  263.             ResetMouseLimits;
  264.             regs.ax:=$1A;
  265.             regs.bx:=1;
  266.             regs.cx:=1;
  267.             regs.dx:=9999;
  268.             intr($33,regs);
  269.             regs.ax:=15;
  270.             regs.cx:=8;
  271.             regs.dx:=16;
  272.             intr($33,regs);
  273.             Regs.ax:=0;
  274.             intr($33,Regs);
  275.             if MouseIsVisible then
  276.                 HideMousePointer;
  277.             FreeMem(MouseBuff,imagesize(1,1,17,17));
  278.         end;
  279.     end;
  280.  
  281. end.